home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 44 / PC Actual CD 44.iso / Linux / Cygwin / full.exe / Disk1 / data1.cab / Tools / share / itcl1.5 / itcl_reload.tcl < prev    next >
Encoding:
Text File  |  1998-12-04  |  3.8 KB  |  102 lines
  1. # ----------------------------------------------------------------------
  2. #  PURPOSE:  Clear all class data and reload a class definition
  3. #
  4. #   AUTHOR:  Michael J. McLennan       Phone: (610)712-2842
  5. #            AT&T Bell Laboratories   E-mail: michael.mclennan@att.com
  6. #
  7. #      RCS:  itcl_reload.tcl,v 1.1.1.1 1994/03/21 22:09:46 mmc Exp
  8. # ----------------------------------------------------------------------
  9. #               Copyright (c) 1993  AT&T Bell Laboratories
  10. # ======================================================================
  11. # Permission to use, copy, modify, and distribute this software and its
  12. # documentation for any purpose and without fee is hereby granted,
  13. # provided that the above copyright notice appear in all copies and that
  14. # both that the copyright notice and warranty disclaimer appear in
  15. # supporting documentation, and that the names of AT&T Bell Laboratories
  16. # any of their entities not be used in advertising or publicity
  17. # pertaining to distribution of the software without specific, written
  18. # prior permission.
  19. #
  20. # AT&T disclaims all warranties with regard to this software, including
  21. # all implied warranties of merchantability and fitness.  In no event
  22. # shall AT&T be liable for any special, indirect or consequential
  23. # damages or any damages whatsoever resulting from loss of use, data or
  24. # profits, whether in an action of contract, negligence or other
  25. # tortuous action, arising out of or in connection with the use or
  26. # performance of this software.
  27. # ======================================================================
  28.  
  29. # ----------------------------------------------------------------------
  30. #  USAGE:  itcl_unload <className>...
  31. #
  32. #  Destroys all objects in the specified classes, and destroys the
  33. #  class definitions.  Also destroys all objects and class definitions
  34. #  that inherit from the specified classes.
  35. # ----------------------------------------------------------------------
  36. proc itcl_unload {args} {
  37.     foreach class [eval itcl_dependencies $args] {
  38.         foreach o [itcl_info objects -class $class] {
  39.             $o delete
  40.         }
  41.         rename $class {}
  42.     }
  43.  
  44.     foreach class $args {
  45.         foreach o [itcl_info objects -class $class] {
  46.             $o delete
  47.         }
  48.         rename $class {}
  49.     }
  50. }
  51.  
  52. # ----------------------------------------------------------------------
  53. #  USAGE:  itcl_reload <className>...
  54. #
  55. #  Destroys all objects in the specified classes, and all objects
  56. #  that inherit from the specified classes.  Destroys and re-loads
  57. #  the specified classes and any other classes that inherit from
  58. #  the specified classes.  Useful during debugging to avoid having
  59. #  to restart the program to recognize source changes.
  60. # ----------------------------------------------------------------------
  61. proc itcl_reload {args} {
  62.     eval itcl_unload $args
  63.  
  64.     #
  65.     # Reload specified classes and dependent classes.
  66.     # NOTE:  Autoloading of class definitions is forced
  67.     #        by invoking the class name with no arguments.
  68.     #
  69.     foreach class $args {
  70.         $class
  71.     }
  72.     foreach class [eval itcl_dependencies $args] {
  73.         $class
  74.     }
  75. }
  76.  
  77. # ----------------------------------------------------------------------
  78. #  USAGE:  itcl_dependencies <className>...
  79. #
  80. #  Returns a list of classes that have the specified classes in their
  81. #  inheritance hierarchy.  Each element in the return list will be
  82. #  a unique class name.  Used in "itcl_unload" and "itcl_reload" to
  83. #  unload and reload derived classes whenever the base classes change.
  84. # ----------------------------------------------------------------------
  85. proc itcl_dependencies {args} {
  86.     set depends(x) make-this-an-array
  87.     unset depends(x)
  88.  
  89.     set classes [itcl_info classes]
  90.     foreach class $args {
  91.         foreach dclass $classes {
  92.             if {$dclass != $class} {
  93.                 set hier [$dclass :: info heritage]
  94.                 if {[lsearch $hier $class] >= 0} {
  95.                     set depends($dclass) $class
  96.                 }
  97.             }
  98.         }
  99.     }
  100.     return [array names depends]
  101. }
  102.